Pascal Super Library/Pascal Super Library (CW International)(1997).bin/CLIPBD_U/CLPBRD/CLIPBRD.PAS

Pascal/Delphi Source File | 1994-09-15 | 5KB | 282 lines

unit ClipBrd;

{ Unit Clipboard, Version 1.00.001, Copyright (c) 1994 by Matthias Köppe.
}

{$G+,X+}

interface

{ Clipboard format identifiers
}
const
  cf_Text         = 1;
  cf_Bitmap       = 2;
  cf_MetaFilePict = 3;
  cf_SYLK         = 4;
  cf_DIF          = 5;
  cf_TIFF         = 6;
  cf_OEMText      = 7;
  cf_DIB          = 8;
  cf_Palette      = 9;

{ Clipboard functions
}
function OpenClipboard: Boolean;
function CloseClipboard: Boolean;
function EmptyClipboard: Boolean;
function SetClipboardData(Format: Word; var Data; Size: LongInt): Boolean;
function GetClipboardDataSize(Format: Word): LongInt;
function GetClipboardData(Format: Word; var Data): Boolean;

{ Emulation control
}
procedure ForceEmulation;

{ WinOldAp-present flag
}
var
  WinOldAp: Boolean;

implementation

type
  PFormatEntry = ^TFormatEntry;
  TFormatEntry = record
    feNext: PFormatEntry;
    feFormat: Word;
    feData: pointer;
    feSize: LongInt
  end;

const
  EmClipboard: PFormatEntry = nil;

var
  SaveExit: pointer;

procedure DetectWinOldAp; near; assembler;
Asm
    MOV    AX, 1700H
    INT    2FH
    CMP    AX, 1700H
    JZ    @@1
    MOV    AL, 1
@@1:    MOV    WinOldAp, AL
End;

procedure FindEntry; near; assembler;
{ In  DX    format id
  Out ES:SI PFormatEntry
}
Asm
    LES    SI, EmClipboard
@@2:    MOV    AX, ES
    OR    AX, SI
    JZ    @@1
    CMP    DX, ES:[SI].TFormatEntry.feFormat
    JE    @@1
    LES    SI, ES:[SI].TFormatEntry.feNext
    JMP    @@2
@@1:
End;

procedure FreeMemProc(p: pointer; Size: Word); near;
Begin
  FreeMem(p, Size)
End;

function GetMemProc(Size: Word): pointer; near;
var
  p: pointer;
Begin
  GetMem(p, Size);
  GetMemProc := p
End;

function OpenClipboard; assembler;
Asm
    CMP    WinOldAp, 0
    JZ    @em
    MOV    AX, 1701H
    INT    2FH
    OR    AX, AX
    JZ    @end
@em:    MOV    AL, 1
@end:
End;

function CloseClipboard; assembler;
Asm
    CMP    WinOldAp, 0
    JZ    @em
    MOV    AX, 1708H
    INT    2FH
    OR    AX, AX
    JZ    @end
@em:    MOV    AL, 1
@end:
End;

function EmptyClipboard; assembler;
Asm
    CMP    WinOldAp, 0
    JZ    @em
    MOV    AX, 1702H
    INT    2FH
    OR    AX, AX
    JNZ    @@1
    JMP    @end
@em:    LES    SI, EmClipboard
    MOV    EmClipboard.Word, 0
    MOV    EmClipboard.2.Word, 0
@@2:    MOV    AX, ES
    OR    AX, SI
    JZ    @@1
    PUSH    ES:[SI].TFormatEntry.feNext.2.Word
    PUSH    ES:[SI].TFormatEntry.feNext.Word
    PUSH    ES
    PUSH    SI
    PUSH    ES:[SI].TFormatEntry.feData.2.Word
    PUSH    ES:[SI].TFormatEntry.feData.Word
    PUSH    ES:[SI].TFormatEntry.feSize.Word
    CALL    FreeMemProc
    PUSH    TYPE TFormatEntry
    CALL    FreeMemProc
    POP    SI
    POP    ES
    JMP    @@2
@@1:    MOV    AL, 1
@end:
End;

function SetClipboardData; assembler;
Asm
    MOV    DX, Format
    CMP    WinOldAp, 0
    JZ    @em
    MOV    AX, 1703H
    LES    BX, Data
    MOV    CX, Size.Word
    MOV    SI, Size.2.Word
    INT    2FH
    OR    AX, AX
    JZ    @end
    PUSH    Data.2.Word
    PUSH    Data.Word
    PUSH    Size.Word
    CALL    FreeMemProc
    JMP    @@3
@em:    CALL    FindEntry
    MOV    AX, ES
    OR    AX, SI
    JZ    @@1
    PUSH    ES
    PUSH    SI
    PUSH    ES:[SI].TFormatEntry.feData.2.Word
    PUSH    ES:[SI].TFormatEntry.feData.Word
    PUSH    ES:[SI].TFormatEntry.feSize.Word
    CALL    FreeMemProc
    POP    DI
    POP    ES
    ADD    DI, TFormatEntry.feData
    CLD
    JMP    @@2
@@1:    PUSH    WORD PTR Size
    CALL    GetMemProc
    MOV    ES, DX
    MOV    DI, AX
    CLD
    XCHG    AX, EmClipboard.Word
    STOSW
    MOV    AX, DX
    XCHG    AX, EmClipboard.2.Word
    STOSW
    MOV    AX, Format
    STOSW
@@2:    MOV    AX, Data.Word
    STOSW
    MOV    AX, Data.2.Word
    STOSW
    MOV    AX, Size.Word
    STOSW
    MOV    AX, Size.2.Word
    STOSW
@@3:    MOV    AL, 1
@end:
End;

function GetClipboardDataSize; assembler;
Asm
    MOV    DX, Format
    CMP    WinOldAp, 0
    JZ    @em
    MOV    AX, 1704H
    INT    2FH
    JMP    @end
@em:    CALL    FindEntry
    MOV    AX, ES
    MOV    DX, SI
    OR    AX, DX
    JZ    @end
    MOV    AX, ES:[SI].TFormatEntry.feSize.Word
    MOV    DX, ES:[SI].TFormatEntry.feSize.2.Word
@end:
End;

function GetClipboardData; assembler;
Asm
    MOV    DX, Format
    CMP    WinOldAp, 0
    JZ    @em
    MOV    AX, 1705H
    LES    BX, Data
    INT    2FH
    OR    AX, AX
    JNZ    @@2
    JMP    @end
@em:    CALL    FindEntry
    MOV    AX, ES
    OR    AX, SI
    JZ    @end
    MOV    CX, ES:[SI].TFormatEntry.feSize.Word
    SHR    CX, 1
    PUSH    DS
    PUSHF
    LDS    SI, ES:[SI].TFormatEntry.feData
    LES    DI, Data
    CLD
    REP    MOVSW
    POPF
    JNC    @@1
    MOVSB
@@1:    POP    DS
@@2:    MOV    AL, 1
@end:
End;

procedure ClipExit; far;
Begin
  EmptyClipboard;
  ExitProc := SaveExit
End;

procedure InstallExit; near;
Begin
  SaveExit := ExitProc;
  ExitProc := @ClipExit
End;

procedure ForceEmulation;
Begin
  If WinOldAp then Begin
    InstallExit;
    WinOldAp := false
  End
End;

Begin
  DetectWinOldAp;
  If not WinOldAp then InstallExit
End.